home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Creative Computers
/
Creative Computers CD-ROM, Volume 1 (Legendary Design Technologies, Inc.)(1994).iso
/
shareware
/
fractals
/
ffex
/
source
/
ffex.mod
< prev
next >
Wrap
Text File
|
1994-11-17
|
18KB
|
526 lines
(* Modul : FFEX *)
(* Projekt : FFEX (Fast Fractal Exploration Set) *)
(* Autor : Robert Brandner *)
(* Funktion : Hauptmodul von FFEX - Menüabfragen, Zoom, Berechnungen ... *)
(* Copyright: Robert Brandner *)
(* Schillerstr. 3 *)
(* A-8280 Fürstenfeld *)
(* AUSTRIA *)
MODULE FFEX;
FROM Menu IMPORT SetMenu, MenuNum, ItemNum, SubNum, NextSelect;
FROM Render IMPORT SetPixel,GetPixel,FastIter16,FastIter32,LongRealIter,
SetNormalPointer,SetZZZPointer,SetZoomPointer;
FROM Request IMPORT Info, GetLimits, Request;
FROM ArpReq IMPORT GetFileName;
FROM IlbmInOut IMPORT LoadILBM, SaveILBM;
FROM Arts IMPORT Assert, TermProcedure;
FROM SYSTEM IMPORT ADR, ADDRESS, CAST, INLINE, LONGSET;
FROM GfxMacros IMPORT RasSize;
FROM Graphics IMPORT ViewModes,ViewModeSet,FontFlags,FontFlagSet,
TextFontPtr, OpenFont,normalFont,TextAttr,CloseFont,
LoadRGB4, SetRGB4, RastPortPtr,RectFill,SetAPen,
SetRast, Move, Draw, SetDrMd, DrawModeSet,DrawModes,
jam1, BltBitMap;
FROM Intuition IMPORT IntuiMessagePtr, menuNull, ShowTitle, ModifyIDCMP,
ScreenPtr,NewScreen,OpenScreen,CloseScreen,
WindowPtr,NewWindow,OpenWindow,CloseWindow,
WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
customScreen, IDCMPFlagSet, IDCMPFlags, ScreenToFront,
ClearMenuStrip, menuDown, menuUp, selectDown, selectUp;
FROM Exec IMPORT FindTask, TaskPtr, GetMsg, ReplyMsg, WaitPort, CopyMem;
FROM Dos IMPORT ProcessPtr;
CONST
SCREENTITLE="Fast Fractal Exploration Set 4.0";
TOPAZ="topaz.font";
LIMIT=4; (* bis zu dieser Größe werden Rechtecke gevierte(i)lt *)
ESCAPE=045H;
MENUFLAGS=IDCMPFlagSet{menuVerify,menuPick,mouseButtons};
STARTPIC="FFEXStart.pic";
TYPE
IterProc=PROCEDURE(LONGREAL,LONGREAL,LONGINT):LONGINT;
VAR
ns : NewScreen;
nw : NewWindow;
Iterations: IterProc;
win : WindowPtr;
scr : ScreenPtr;
topaz80 : TextFontPtr;
attr : TextAttr;
thisTask : ProcessPtr;
QUIT,title: BOOLEAN;
yadr : ARRAY[0..512] OF LONGINT;
rp : RastPortPtr;
msg : IntuiMessagePtr;
class : IDCMPFlagSet;
code : CARDINAL;
xres,yres,depth,i,maxcol: INTEGER;
xmin,ymin,xmax,ymax : LONGREAL; (* Koord. des zu zeichnenden Bildes *)
xminr,yminr,xmaxr,ymaxr : LONGREAL; (* Koord. des letzten gez. Bildes *)
x1,y1,x2,y2 : LONGREAL; (* Hilfsvariablen *)
maxiter : LONGINT;
zx,zy,zdx,zdy : INTEGER; (* Zoomrahmen *)
fileok : BOOLEAN;
fname : ARRAY[0..255] OF CHAR; (* für Filerequester *)
saved : BOOLEAN;
mess : ARRAY[0..80] OF CHAR;
no,yes : ARRAY[0..9] OF CHAR;
PROCEDURE TextColorsOn; FORWARD;
PROCEDURE TextColorsOff; FORWARD;
PROCEDURE CreateDisplay(w,h,d:INTEGER); FORWARD;
PROCEDURE LoadIff(fn:BOOLEAN);
VAR
i,planebytes,ok:LONGINT;
lscr:ScreenPtr;
BEGIN
IF NOT saved THEN
mess:="This picture is not saved!|If you continue, it will be lost!";
yes:="CONTINUE"; no:="CANCEL";
IF NOT Request(win,mess,yes,no) THEN RETURN END;
END;
INCL(win^.flags,rmbTrap);
ModifyIDCMP(win,IDCMPFlagSet{});
IF fn THEN
TextColorsOn;
fileok:=GetFileName(win,ADR("Load File"),ADR(fname));
TextColorsOff;
ELSE
fileok:=TRUE
END;
IF fileok THEN
SetZZZPointer(win);
fileok:=LoadILBM(fname,win,lscr,xminr,yminr,xmaxr,ymaxr,maxiter);
IF fileok THEN
xmin:=xminr; ymin:=yminr; xmax:=xmaxr; ymax:=ymaxr;
IF (lscr^.width#xres) OR (lscr^.height#yres) THEN
CreateDisplay(lscr^.width,lscr^.height,INTEGER(lscr^.bitMap.depth));
END;
saved:=TRUE;
ShowTitle(scr,FALSE);
ok:=BltBitMap(ADR(lscr^.bitMap),0,0,ADR(scr^.bitMap),0,0,
xres,yres,0C0H,0FFH,NIL);
ShowTitle(scr,title);
CloseScreen(lscr);
END;
SetNormalPointer(win);
END;
EXCL(win^.flags,rmbTrap);
ModifyIDCMP(win,MENUFLAGS);
END LoadIff;
PROCEDURE SaveIff;
BEGIN
ClearMenuStrip(win);
ModifyIDCMP(win,IDCMPFlagSet{});
TextColorsOn;
fileok:=GetFileName(win,ADR("Save File"),ADR(fname));
TextColorsOff;
IF fileok THEN
INCL(win^.flags,rmbTrap);
SetZZZPointer(win); ShowTitle(scr,FALSE);
fileok:=SaveILBM(fname,scr,xminr,yminr,xmaxr,ymaxr,maxiter);
saved:=fileok;
SetNormalPointer(win); ShowTitle(scr,title); EXCL(win^.flags,rmbTrap);
END;
ModifyIDCMP(win,MENUFLAGS);
SetMenu(win);
END SaveIff;
(*** Prozeduren für Screen und Window ********************************)
PROCEDURE ColorTable; (* $E- *)
BEGIN
INLINE(00000H,00FF0H,00FD0H,00FB0H,00F80H,00F60H,00F40H,00F20H,
00F00H,00F02H,00F05H,00F07H,00F09H,00F0BH,00F0DH,00F0FH,
00D0FH,00B0FH,0090FH,0070FH,0050FH,0030FH,0010FH,0001FH,
0003FH,0005FH,0007FH,0009FH,000BFH,000DFH,000FFH,00DDDH);
END ColorTable;
PROCEDURE CloseIfOpen;
BEGIN
thisTask:=CAST(ProcessPtr,FindTask(NIL));
thisTask^.windowPtr:=NIL;
IF win#NIL THEN CloseWindow(win); win:=NIL END;
IF scr#NIL THEN CloseScreen(scr); scr:=NIL END;
END CloseIfOpen;
PROCEDURE CreateDisplay(w,h,d:INTEGER);
BEGIN
xres:=w; yres:=h; depth:=d; (* Werte für DrawFractal/Zoom merken *)
IF NOT saved THEN
mess:="This picture is not saved!|If you continue, it will be lost!";
yes:="CONTINUE"; no:="CANCEL";
IF NOT Request(win,mess,yes,no) THEN RETURN END;
END;
CloseIfOpen;
WITH ns DO
width:=w; height:=h; depth:=d; detailPen:=6; blockPen:=1;
viewModes:=ViewModeSet{};
IF w>320 THEN INCL(viewModes,hires) END;
IF h>256 THEN INCL(viewModes,lace) END;
type:=customScreen+ScreenFlagSet{screenBehind};
font:=ADR(attr); defaultTitle:=ADR(SCREENTITLE);
gadgets:=NIL; customBitMap:=NIL;
END;
scr:=OpenScreen(ns);
Assert(scr#NIL,ADR("OpenScreen() failed!"));
LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
IF d=5 THEN maxcol:=31 ELSE maxcol:=15 END;
WITH nw DO
width:=w; height:=h; detailPen:=3; blockPen:=1;
idcmpFlags:=IDCMPFlagSet{menuVerify, menuPick, mouseButtons};
flags:=WindowFlagSet{reportMouse,backDrop,borderless,
activate,noCareRefresh};
firstGadget:=NIL;checkMark:=NIL;title:=NIL;
screen:=scr; bitMap:=NIL;
minWidth:=0; minHeight:=0; maxWidth:=-1; maxHeight:=-1;
type:=customScreen;
END;
win:=OpenWindow(nw);
Assert(win#NIL,ADR("OpenWindow() failed!"));
rp:=win^.rPort;
FOR i:=0 TO h-1 DO (* Zeilenadressen berechnen *)
yadr[i]:=LONGINT(i)*LONGINT(rp^.bitMap^.bytesPerRow);
END;
ScreenToFront(scr);
thisTask:=CAST(ProcessPtr,FindTask(NIL)); (* Systemrequester auf *)
thisTask^.windowPtr:=win; (* eigenem Screen. *)
SetMenu(win);
title:=TRUE; ShowTitle(scr,title);
END CreateDisplay;
(*** Prozeduren für Fraktalgrafik ************************************)
PROCEDURE DrawFractal(rmin,rmax,imin,imax:LONGREAL;
maxcol:INTEGER;
maxiter:LONGINT);
VAR
r,cxr,cyr,dxr,dyr:LONGREAL;
lc:LONGINT;
exit:BOOLEAN;
PROCEDURE HLine(xmin,xmax,y:INTEGER); (* waagrechte Linie *)
BEGIN
cxr:=rmin+LONGREAL(xmin)*dxr;cyr:=imin+LONGREAL(y)*dyr;
FOR i:=xmin TO xmax DO
lc:=Iterations(cxr,cyr,maxiter);cxr:=cxr+dxr;
SetPixel(i,yadr[y],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
END
END HLine;
PROCEDURE VLine(ymin,ymax,x:INTEGER); (* senkrechte Linie *)
BEGIN
cxr:=rmin+LONGREAL(x)*dxr;cyr:=imin+LONGREAL(ymin)*dyr;
FOR i:=ymin TO ymax DO
lc:=Iterations(cxr,cyr,maxiter);cyr:=cyr+dyr;
SetPixel(x,yadr[i],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
END
END VLine;
PROCEDURE Rectangle(xmin,ymin,xmax,ymax:INTEGER);
VAR
eq:BOOLEAN;
dx2,dy2,k:INTEGER;
BEGIN
IF exit THEN RETURN END;
msg:=GetMsg(win^.userPort);
IF msg#NIL THEN
ReplyMsg(msg);
IF msg^.code=ESCAPE THEN exit:=TRUE END;
END;
dx2:=(xmax-xmin);dy2:=(ymax-ymin);